home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-01 / dkbuts.zip / TCE.BAS < prev    next >
BASIC Source File  |  1991-05-16  |  25KB  |  781 lines
  1. '*****************
  2. ' Filename: TCE.BAS (The Color Editor)
  3. ' Function: Edit/Create DKB Color declarations.
  4. ' Written by: Dan Farmer
  5. ' Date: 03/26/91
  6. ' Version 1.0
  7. ' NOTES:
  8. ' Color 0 (background color) is set to mid-gray for use by gui-panels.
  9. ' Color displayed in sample window is palette index #1.
  10. ' Colors 17 - 255 used for the preview sphere gradient and are re-set when
  11. '        previewing.
  12. '--------------------------------------------
  13. ' Revision History: (Who, when, what)
  14. ' 03/26/91 DFM  Original release.
  15. '---------------------------------
  16. ' 04/03/91 DMF  Make.Gradient.Palette(): Better palette scaling.
  17. '               Sphere() : Use PSET instead of LINE for background of view.
  18. '                          "Seamless paper" backdrop for view.
  19. '
  20. ' 04/04/91 DMF  Draw the preview sphere only once and keep it on the scren,
  21. '               "P"review now only updates the palette.  Faster, plus you
  22. '               can compare two colors on screen at once.  Wish I could
  23. '               page-flip in mode 13 and draw it "in the dark".
  24. '
  25. ' 04/10/91 DMF -Load full filename from commandline instead of just path
  26. '               to it.  DKB2.10 calls the color file COLORS.DAT rather
  27. '               than COLOR.DAT.  User may have other color files, too!
  28. '              -Ability to specify input and output filenames.  Also
  29. '               now prompts for input filename if none given at loadtime.
  30. '
  31. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  32. ''  Conversion notes:                                          ''
  33. ''     DEFINT means any untyped variable defaults to INT       ''
  34. ''     GET #1,,IN$ means get from file #1 into IN$ for a length''
  35. ''        of however big IN$ already is.                       ''
  36. ''     COMMAND$ is the command line less the program name. Just''
  37. ''        rewrite the lousy BASIC interpretation of parameters.''
  38. ''     Type ! is a float, & is a long int, # is an 8-byte float''
  39. ''     STRING$(n,c) function returns a string containing 'n'   ''
  40. ''        occurances of the character 'c'.                     ''
  41. ''     FUNCTION returns a value.  SUB doesn't (void)           ''
  42. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  43. OPTION BASE 1       ' Set default lowest bound for arrays to 1
  44.  
  45. DECLARE FUNCTION Color.Set.Shade& (red!, green!, blue!)
  46.  
  47. DECLARE SUB Color.Set.And.Show.Current (red!, green!, blue!)
  48. DECLARE SUB Color.Set.Values (Amount!, hue!)
  49. DECLARE SUB Color.Clear.Values (value!, red!, green!, blue!)
  50. DECLARE SUB Color.Write.Data (ColorName$, red!, green!, blue!, recno, Reccount, ColorBuffer$())
  51. DECLARE SUB Color.Load.Color.File (Reccount!, recno!)
  52. DECLARE SUB Color.Parse.Color.File (a$, Buffer$(), recno!)
  53. DECLARE SUB Color.Convert.Color.Data (recno!, Buffer$(), red!, green!, blue!)
  54. DECLARE SUB Color.Make.Gradient.Palette (red!, green!, blue!)
  55. DECLARE SUB Color.Preview.Sphere (Xc%, Yc%, Radius!, red!, green!, blue!)
  56. DECLARE SUB Gui.Clear.Msg (AtRow!)
  57. DECLARE SUB Gui.KbGet (a$)
  58. DECLARE SUB Gui.Center.Msg (AtRow, a$)
  59. DECLARE SUB Gui.CapsState ()
  60. DECLARE SUB Gui.Panel (WinLeft%, WinTop%, WinRight%, WinBottom%, Depth%)
  61. DECLARE SUB Gui.Screen.Init ()
  62. DECLARE SUB Gui.Waitkey ()
  63. DECLARE SUB Chime.Friendly ()
  64. DECLARE SUB Chime.Warning ()
  65.  
  66.  
  67. COMMON SHARED FileName$
  68. COMMON SHARED Input.File$, Output.File$, Input.File.Handle, Output.File.Handle
  69. COMMON SHARED ESC$, CursorUp$, CursorDown$
  70. COMMON SHARED Reccount, recno
  71. COMMON SHARED MoreRedButton%, MoreGreenButton%, MoreBlueButton%
  72. COMMON SHARED LessRedButton%, LessGreenButton%, LessBlueButton%
  73. COMMON SHARED BrightenButton%, DarkenButton%, PreviewButton%, SaveButton%
  74. COMMON SHARED ClearButton%, InOutButton%
  75. COMMON SHARED Good.Input.File$
  76.  
  77. CONST FALSE = 0, TRUE = NOT FALSE
  78. CONST MAXRECS = 512                            ' Way more than enough
  79. ESC$ = CHR$(27)
  80. F1$ = CHR$(0) + CHR$(59)
  81. CursorUp$ = CHR$(0) + CHR$(72)
  82. CursorDown$ = CHR$(0) + CHR$(80)
  83.  
  84. ' ColorBuffer$: Element #1:= Color Name$   #2:= red$   #3:= green$   #4:=blue$
  85. DIM SHARED ColorBuffer$(MAXRECS, 4)
  86.  
  87. CONST Color.Values.Row = 2
  88. CONST Color.Name.Row = 12
  89.  
  90. ' Flags for gui-button status
  91. MoreRedButton% = 1: MoreGreenButton% = 1: MoreBlueButton% = 1
  92. LessRedButton% = 1: LessGreenButton% = 1: LessBlueButton% = 1
  93. BrightenButton% = 1: DarkenButton% = 1: PreviewButton% = 1: SaveButton% = 1
  94. ClearButton% = 1: InOutButton% = 1
  95.  
  96. ' Find override color file dir/name
  97. FileName$ = COMMAND$                               ' Check argv first
  98. IF FileName$ = "" THEN FileName$ = ENVIRON$("DKB") ' Check environ variable
  99. IF FileName$ = "" THEN FileName$ = "COLORS.DAT"    ' Use default
  100.  
  101. Input.File$ = FileName$
  102. Output.File$ = FileName$                           ' May be changed by user
  103.  
  104. Input.File.Handle = 1
  105. Output.File.Handle = 2
  106.  
  107.  
  108. Reccount = 0                        ' Number of "records" in color buffer
  109. recno = 0                           ' Index pointer to current color in buffer
  110. incr = .01                          ' Color increment rate.  Toggles to 0.10
  111. MAIN:
  112.     CALL Gui.Screen.Init
  113.  
  114.     '   --- Load COLOR.DAT file into memory (ColorBuffer$)
  115.     CALL Color.Load.Color.File(Reccount, recno)            '
  116.  
  117.     '   --- Convert rgb into long int
  118.     CALL Color.Convert.Color.Data(recno, ColorBuffer$(), red!, green!, blue!)
  119.  
  120.     Msg$ = ColorBuffer$(recno, 1)
  121.     DO                                                    ' Loop unit ESC$
  122.         GOSUB Screen.Freshen
  123.         CALL Gui.KbGet(a$)
  124.         CALL Gui.Clear.Msg(12)
  125.  
  126.  
  127.         SELECT CASE a$
  128.  
  129.             '   --- Cursor Up/Down picks next/prev COLORS.DAT color.
  130.             '       Other keys affect the color displayed currently.
  131.             CASE CursorDown$
  132.                 recno = recno + 1: IF recno > Reccount THEN recno = 1
  133.                 CALL Color.Convert.Color.Data(recno, ColorBuffer$(), red!, green!, blue!)
  134.                 Msg$ = ColorBuffer$(recno, 1)
  135.  
  136.             CASE CursorUp$
  137.                 recno = recno - 1: IF recno < 1 THEN recno = Reccount
  138.                 CALL Color.Convert.Color.Data(recno, ColorBuffer$(), red!, green!, blue!)
  139.                 Msg$ = ColorBuffer$(recno, 1)
  140.  
  141.             CASE "+", "="
  142.                 IF incr = .01 THEN incr = .1 ELSE incr = .01   'Toggle increment
  143.  
  144.             CASE "R"
  145.                 IF red! < 1 THEN
  146.                     Msg$ = "Increasing Red"
  147.                     CALL Color.Set.Values(incr, red!)
  148.                     MoreRedButton% = -1: LessRedButton% = 1
  149.                 ELSE
  150.                     CALL Chime.Friendly
  151.                     Msg$ = "Max Red!"
  152.                 END IF
  153.  
  154.             CASE "r"
  155.                 IF red! > 0 THEN
  156.                     Msg$ = "Decreasing Red"
  157.                     CALL Color.Set.Values(-incr, red!)
  158.                     LessRedButton% = -1: MoreRedButton% = 1
  159.                 ELSE
  160.                     CALL Chime.Friendly
  161.                     Msg$ = "Red is zero!"
  162.                 END IF
  163.  
  164.             CASE "G"
  165.                 IF green! < 1 THEN
  166.                     Msg$ = "Increasing Green"
  167.                     CALL Color.Set.Values(incr, green!)
  168.                     MoreGreenButton% = -1: LessGreenButton% = 1
  169.                 ELSE
  170.                     CALL Chime.Friendly
  171.                     Msg$ = "Max Green!"
  172.                 END IF
  173.  
  174.  
  175.             CASE "g"
  176.                 IF green! > 0 THEN
  177.                     Msg$ = "Decreasing Green"
  178.                     CALL Color.Set.Values(-incr, green!)
  179.                     LessGreenButton% = -1: MoreGreenButton% = 1
  180.                 ELSE
  181.                     CALL Chime.Friendly
  182.                     Msg$ = "Green is zero!"
  183.                 END IF
  184.  
  185.  
  186.             CASE "B"
  187.                 IF blue! < 1 THEN
  188.                     Msg$ = "Increasing Blue"
  189.                     CALL Color.Set.Values(incr, blue!)
  190.                     MoreBlueButton% = -1: LessBlueButton% = 1
  191.                 ELSE
  192.                     CALL Chime.Friendly
  193.                     Msg$ = "Max Blue!"
  194.                 END IF
  195.  
  196.             CASE "b"
  197.                 IF blue! > 0 THEN
  198.                     Msg$ = "Decreasing Blue"
  199.                     CALL Color.Set.Values(-incr, blue!)
  200.                     LessBlueButton% = -1: MoreBlueButton% = 1
  201.                 ELSE
  202.                     CALL Chime.Friendly
  203.                     Msg$ = "Blue is zero!"
  204.                 END IF
  205.  
  206.             CASE "L", "l"
  207.                     IF red! = 1 AND green! = 1 AND blue! = 1 THEN
  208.                         Msg$ = "Can't brighten WHITE!"
  209.                         CALL Chime.Warning
  210.                     ELSE
  211.                         BrightenButton% = -1
  212.                         Msg$ = "Lightening Hue"
  213.                         IF red! < 1 THEN CALL Color.Set.Values(incr, red!)
  214.                         IF green! < 1 THEN CALL Color.Set.Values(incr, green!)
  215.                         IF blue! < 1 THEN CALL Color.Set.Values(incr, blue!)
  216.                     END IF
  217.  
  218.             CASE "D", "d"
  219.                     IF red! = 0 AND green! = 0 AND blue = 0 THEN
  220.                         Msg$ = "Can't darken BLACK!"
  221.                         CALL Chime.Warning
  222.                     ELSE
  223.                         DarkenButton% = -1
  224.                         Msg$ = "Darkening Hue"
  225.                         IF red! > 0 THEN CALL Color.Set.Values(-incr, red!)
  226.                         IF green! > 0 THEN CALL Color.Set.Values(-incr, green!)
  227.                         IF blue! > 0 THEN CALL Color.Set.Values(-incr, blue!)
  228.                     END IF
  229.  
  230.             CASE "C", "c"
  231.                 Saved.Msg$ = Msg$
  232.                 ClearButton% = -1
  233.                 Msg$ = "[W]hite, [G]ray, or [B]lack?"
  234.                 GOSUB Screen.Freshen
  235.                 a$ = ""
  236.                 WHILE a$ = "": a$ = INKEY$: WEND
  237.                 IF INSTR("Ww", a$) THEN
  238.                     CALL Color.Clear.Values(1!, red!, green!, blue!)
  239.                     Msg2$ = "White"
  240.                 ELSEIF INSTR("Gg", a$) THEN
  241.                     CALL Color.Clear.Values(.5, red!, green!, blue!)
  242.                     Msg2$ = "Middle Gray"
  243.                 ELSEIF INSTR("Bb", a$) THEN
  244.                     CALL Color.Clear.Values(0!, red!, green!, blue!)
  245.                     Msg2$ = "Black"
  246.                 ELSE
  247.                     Msg2$ = Saved.Msg$
  248.                 END IF
  249.                 Msg$ = "": GOSUB Screen.Freshen
  250.                 Msg$ = Msg2$: GOSUB Screen.Freshen: Msg2$ = ""
  251.  
  252.             CASE "S", "s", "W", "w"
  253.                 Old.Color.Name$ = Msg$
  254.                 SaveButton% = -1: Msg$ = "": GOSUB Screen.Freshen
  255.                 CALL Gui.Center.Msg(12, "Color name:" + SPACE$(20))
  256.                 LOCATE 12, POS(0) - 20
  257.                 LINE INPUT Color.Name$
  258.                 CALL Color.Write.Data(Color.Name$, red!, green!, blue!, recno, Reccount, ColorBuffer$())
  259.                 CALL Gui.Clear.Msg(12)
  260.                 IF LTRIM$(Color.Name$) = "" THEN Color.Name$ = Old.Color.Name$
  261.                 Msg$ = Color.Name$
  262.  
  263.             CASE "V", "v", "P", "p"
  264.                 PreviewButton% = -1
  265.                 CALL Color.Make.Gradient.Palette(red!, green!, blue!)
  266.  
  267.             CASE "F", "f", "I", "i"
  268.                 InOutButton% = -1
  269.                 Saved.Msg$ = Msg$
  270.                 Msg$ = "[I]nput or [O]utput file?"
  271.                 GOSUB Screen.Freshen
  272.                 a$ = ""
  273.                 WHILE a$ = "": a$ = INKEY$: WEND
  274.                 CALL Gui.Clear.Msg(12)
  275.                 IF INSTR("Ii", a$) THEN          ' Input file
  276.                     ' The ON ERROR handler in Color.Load.Color.File will ask for
  277.                     ' a new filename if passed a bad one.
  278.                     Input.File$ = "  "
  279.                     Reccount = 0
  280.                     recno = 0
  281.                     CALL Color.Load.Color.File(Reccount, recno)
  282.                     CALL Gui.Clear.Msg(12)
  283.  
  284.                 ELSEIF INSTR("Oo", a$) THEN      ' Output file
  285.                     InOutButton% = -1
  286.                     CALL Gui.Center.Msg(12, "Output file:" + SPACE$(20))
  287.                     LOCATE 12, POS(0) - 20
  288.                     ' Output file is always closed except when writing to it
  289.                     ' so there's no need to open it now.  Just get the name.
  290.                     LINE INPUT Output.File$
  291.                     CALL Gui.Clear.Msg(12)
  292.  
  293.                 ELSE
  294.                     Msg2$ = Saved.Msg$
  295.                 END IF
  296.                 Msg$ = "": GOSUB Screen.Freshen
  297.                 Msg$ = Msg2$: GOSUB Screen.Freshen: Msg2$ = ""
  298.  
  299.             CASE ESC$
  300.                 ' DON'T BEEP
  301.             CASE ELSE
  302.                 Msg$ = "Invalid keypress"
  303.                 CALL Chime.Warning
  304.         END SELECT
  305.     LOOP WHILE a$ <> ESC$
  306.  
  307. END.PROGRAM:
  308.     SCREEN 0: WIDTH 80: CLS
  309.     LOCATE 10, 1
  310.     PRINT "                      ┌─Thank you for using───────────┐"
  311.     PRINT "                      │ TCE: The Color Editor         │"
  312.     PRINT "                      │ Copyright By Dan Farmer, 1991 │"
  313.     PRINT "                      │ All rights reserved.          │"
  314.     PRINT "                      └───────────────────────────────┘"
  315. END
  316. '--------------------------- end of main ------------------------------------
  317.  
  318. ' --- Repaint the screen, update button status, show current color in window.
  319. Screen.Freshen:
  320.     COLOR 8
  321.     LOCATE 22, 11: PRINT "TCE:The Color Editor"
  322.  
  323.     '   --- Little "wings" logo (BirdWARE logo?)
  324. LogoColors:  DATA 4,2,3
  325.     RESTORE LogoColors
  326.     FOR i% = 2 TO 6 STEP 2
  327.         READ a
  328.         LINE (46 + i% * 2, 168 + i%)-(73, 168 + i%), a
  329.         LINE (246, 168 + i%)-(273 - i% * 2, 168 + i%), a
  330.     NEXT i%
  331.     CALL Gui.Panel(148, 182, 234, 192, 1)  ' ESC to quit message panel
  332.  
  333.  
  334.     COLOR 8
  335.     LOCATE 24, 20: PRINT "[ESC] Quit";
  336.     LOCATE 24, 36: IF incr = .1 THEN PRINT "Fast";  ELSE PRINT "Slow";
  337.  
  338.     '   --- Display Message in color name window
  339.     CALL Gui.Center.Msg(12, Msg$)
  340.  
  341.  
  342.    '--- "Radio Buttons"
  343.    '    --- Left side, Left column
  344.    CALL Gui.Panel(13, 101, 40, 113, MoreRedButton%)
  345.    COLOR 4
  346.    LOCATE 14, 3: PRINT "R";                 ' chr(24)
  347.    CALL Gui.Panel(13, 117, 40, 129, MoreGreenButton%)
  348.    COLOR 2
  349.    LOCATE 16, 3: PRINT "G";
  350.    CALL Gui.Panel(13, 133, 40, 145, MoreBlueButton%)
  351.    COLOR 3
  352.    LOCATE 18, 3: PRINT "B";
  353.    CALL Gui.Panel(13, 149, 40, 161, BrightenButton%)
  354.    COLOR 8
  355.    LOCATE 20, 3: PRINT "Ltn";                 ' chr(18)
  356.   
  357.    '    --- Left side, Right column
  358.    CALL Gui.Panel(46, 101, 73, 113, LessRedButton%)
  359.    COLOR 4
  360.    LOCATE 14, 7: PRINT "r";                  ' chr(25)
  361.    CALL Gui.Panel(46, 117, 73, 129, LessGreenButton%)
  362.    COLOR 2
  363.    LOCATE 16, 7: PRINT "g";
  364.    CALL Gui.Panel(46, 133, 73, 145, LessBlueButton%)
  365.    COLOR 3
  366.    LOCATE 18, 7: PRINT "b";
  367.    CALL Gui.Panel(46, 149, 73, 161, DarkenButton%)
  368.    COLOR 8
  369.    LOCATE 20, 7: PRINT "Dkn";
  370.    COLOR 8
  371.  
  372.    '    --- Right side
  373.    CALL Gui.Panel(246, 101, 306, 113, PreviewButton%)
  374.    LOCATE 14, 32: PRINT "Preview"
  375.    CALL Gui.Panel(246, 117, 306, 129, SaveButton%)
  376.    LOCATE 16, 32: PRINT "Save"
  377.    CALL Gui.Panel(246, 133, 306, 145, ClearButton%)
  378.    LOCATE 18, 32: PRINT "Clear";
  379.    COLOR 7
  380.  
  381.     CALL Color.Set.And.Show.Current(red!, green!, blue!)      ' Show the color
  382.  
  383. RETURN
  384.  
  385. ' ---- Called if color file not found or user pressed "F"ile / "I"nput file.
  386. GetInputFile:
  387.  
  388.     COLOR 8
  389.  
  390.     CLOSE #Input.File.Handle                       ' Avoid "file already open"
  391.     CALL Gui.Center.Msg(12, "Input file:" + SPACE$(20))
  392.     LOCATE 12, POS(0) - 20                         ' Backspace for input
  393.     LINE INPUT Input.File$                         ' Get filename from user
  394.  
  395.     Reccount = 0                                   ' Reset counters
  396.     recno = 0
  397.  
  398.     CALL Gui.Clear.Msg(12)
  399.  
  400.     IF Input.File$ = "" THEN
  401.         IF Good.Input.File$ = "" THEN
  402.             CLS : WIDTH 80: PRINT : PRINT
  403.             PRINT "TCE Error: Input filename not specified."
  404.             PRINT "           Useage : TCE d:\path\filename.ext"
  405.             PRINT "                or: SET DKB=d:\path\filename.ext"
  406.             PRINT "           where filename is your DKB color file."
  407.             PRINT
  408.             SYSTEM
  409.         ELSE
  410.             Input.File$ = Good.Input.File$  'resort to last good filename
  411.             RESUME
  412.         END IF
  413.     ELSE
  414.         RESUME
  415.     END IF
  416.  
  417. RETURN
  418.  
  419. SUB Chime.Friendly
  420.     SOUND 1500, .1
  421.     SOUND 3000, .1
  422. END SUB
  423.  
  424. SUB Chime.Warning
  425. '    SOUND 40, 3
  426. END SUB
  427.  
  428. ' --- Reset all RGB values to zero
  429. SUB Color.Clear.Values (value!, red!, green!, blue!) STATIC
  430.     red! = value!: green! = value!: blue! = value!
  431. END SUB
  432.  
  433. '   --- Convert values in color buffer to rgb floats
  434. SUB Color.Convert.Color.Data (recno, Buffer$(), red!, green!, blue!) STATIC
  435.     red! = VAL(Buffer$(recno, 2))
  436.     green! = VAL(Buffer$(recno, 3))
  437.     blue! = VAL(Buffer$(recno, 4))
  438. END SUB
  439.  
  440. '   --- Load COLORS.DAT into a buffer.
  441. '       Requires COMMON input.file.handle,input.file$
  442. '       and CONST MAXRECS
  443. SUB Color.Load.Color.File (Reccount, recno) STATIC
  444. STATIC Work$
  445.  
  446.     CLOSE #Input.File.Handle
  447.     ON ERROR GOTO GetInputFile
  448.     OPEN Input.File$ FOR INPUT AS #Input.File.Handle
  449.     ON ERROR GOTO 0     ' This clears the ON ERROR event driver
  450.     Good.Input.File$ = Input.File$
  451.  
  452.     ' Since COLOR.DAT is composed of variable-length records, RANDOM file access
  453.     ' is not workable, so let's fake it with an array.
  454.     recno = 1
  455.  
  456.     ' Sample Line = "DECLARE White = COLOUR RED 1.0 GREEN 1.0 BLUE 1.0"
  457.     DO WHILE NOT EOF(Input.File.Handle)
  458.         INPUT #Input.File.Handle, Work$      ' read in one line as a string
  459.         CALL Color.Parse.Color.File(LTRIM$(Work$), ColorBuffer$(), recno)
  460.     LOOP
  461.  
  462.     CLOSE #Input.File.Handle
  463.     Reccount = recno - 1
  464.     recno = 1
  465. END SUB
  466.  
  467. '   --- This routine probably needs some work.  Aaron says to look at his
  468. '       hsv_to_rgb routine in the DKB imb.c code.
  469. '       What I am *trying* to do is make a dark-to-light gradient for the
  470. '       current color.  This is then used to paint the preview image.
  471. SUB Color.Make.Gradient.Palette (red!, green!, blue!) STATIC
  472. STATIC red2!, green2!, blue2!
  473.  
  474.     ambient = .25
  475.     diffuse = 1 - ambient
  476.  
  477.     MAXCOLORS = 255
  478.     COLOROFFSET = 17
  479.     numcolors = MAXCOLORS - COLOROFFSET
  480.     red.scale = red! + diffuse
  481.     green.scale = green! + diffuse
  482.     blue.scale = blue! + diffuse
  483.  
  484.     redincr! = red! / numcolors * red.scale
  485.     greenincr! = green! / numcolors * green.scale
  486.     blueincr! = blue! / numcolors * blue.scale
  487.  
  488.     red2! = ambient + redincr!: green2! = ambient + greenincr!: blue2! = ambient + blueincr!
  489.  
  490.  
  491.     ' Set pallette indices 17 - 255 from dark hue to bright hue
  492.     FOR i% = 1 TO numcolors
  493.         PALETTE COLOROFFSET + i%, Color.Set.Shade&(red2!, green2!, blue2!)
  494.           CALL Color.Set.Values(redincr!, red2!)
  495.           CALL Color.Set.Values(greenincr!, green2!)
  496.           CALL Color.Set.Values(blueincr!, blue2)
  497.     NEXT i%
  498. END SUB
  499.  
  500. SUB Color.Parse.Color.File (a$, Buffer$(), recno) STATIC
  501. STATIC red$, green$, blue$, IsRed, IsGreen, IsBlue, ColorName$, EqualSign
  502.  
  503.         IF INSTR(a$, "DECLARE") THEN
  504.             a$ = LTRIM$(RTRIM$(MID$(a$, 8)))            ' strip the DECLARE
  505.             ColorName$ = LTRIM$(RTRIM$(MID$(a$, 8)))    ' parse the name
  506.             EqualSign = INSTR(a$, "=")
  507.             ColorName$ = LTRIM$(RTRIM$(LEFT$(a$, EqualSign - 1)))
  508.             Buffer$(recno, 1) = ColorName$              ' put name in buffer
  509.  
  510.             IsRed = INSTR(a$, "RED")                    ' parse RED value
  511.             IF IsRed THEN
  512.                 red$ = MID$(a$, IsRed + 4)
  513.             ELSE
  514.                 red$ = "0.0"
  515.             END IF
  516.             Buffer$(recno, 2) = red$
  517.  
  518.             IsGreen = INSTR(a$, "GREEN")                ' parse GREEN value
  519.             IF IsGreen THEN
  520.                 green$ = MID$(a$, IsGreen + 6)
  521.             ELSE
  522.                 green$ = "0.0"
  523.             END IF
  524.             Buffer$(recno, 3) = green$
  525.  
  526.             IsBlue = INSTR(a$, "BLUE")                  ' parse BLUE value
  527.             IF IsBlue THEN
  528.                 blue$ = MID$(a$, IsBlue + 5)
  529.             ELSE
  530.                 blue$ = "0.0"
  531.             END IF
  532.             Buffer$(recno, 4) = blue$
  533.  
  534.             recno = recno + 1                           ' increment record#
  535.  
  536.         END IF
  537. END SUB
  538.  
  539. SUB Color.Preview.Sphere (Xc%, Yc%, Radius!, red!, green!, blue!) STATIC
  540.  
  541.     ' Gui Panel parms := " Left, Top, Right, Bottom, +/-Depth
  542.     CALL Gui.Panel(80, 101, 240, 161, -2)    ' Make a viewing window
  543.  
  544.     CALL Color.Make.Gradient.Palette(red!, green!, blue!)
  545.  
  546.     '   --- Draw sky and a shaded floor
  547.     horizon% = 120
  548.     FOR y% = 103 TO 159
  549.         FOR x% = 82 TO 238
  550.             IF y% < horizon% THEN
  551.                 PSET (x%, y%), 119    ' mid-range "sky" (our actual color)
  552.             ELSE
  553.                 PSET (x%, y%), 16 + (y% - horizon%) * 3
  554.             END IF
  555.         NEXT x%
  556.     NEXT y%
  557.  
  558.  
  559.     '   --- Note: The following two lines are NOT generic.  They are
  560.     '       hard-coded by trial and error for correct placement.  My
  561.     '       Momma taught me better- she really did!
  562.  
  563.     '   --- Draw a projected shadow
  564.     ambient = 40
  565.     CIRCLE (Xc% + 10, Yc% + Radius! * .52), Radius!, ambient, , , .3
  566.     PAINT (Xc% + 10, Yc% + Radius! * .52), ambient
  567.  
  568.     ' --- Draw a shaded Color.Preview.Sphere by reducing the radius of and
  569.     ' moving the center of a filled circle while cycling the palette
  570.     ' from dark to light.
  571.    
  572.     BStep! = 0
  573.     FOR i% = 1 TO 238
  574.         kolor% = i% + 20                     ' Skip reserved colors & darkest 4
  575.         IF kolor% > 255 THEN kolor% = 255     'cause I screw up!
  576.         Radius! = Radius! - .12: IF Radius! < 1 THEN Radius! = 1
  577.         BStep! = BStep! + .06                 ' offsets the next circle x & y
  578.         x% = Xc% - BStep! / 1.75               ' shift the hilight left
  579.         y% = Yc% - BStep!                     ' shift the hilight upwards
  580.         CIRCLE (x%, y%), Radius!, kolor%
  581.         PAINT (x%, y%), kolor%
  582.     NEXT i%
  583. END SUB
  584.  
  585. '   --- Display a box filled with the current hue
  586. '       Requires PUBLIC CONSTANT named Color.Values.Row (could be hard-coded)
  587. '       Sets Pallette index 1
  588. SUB Color.Set.And.Show.Current (red!, green!, blue!) STATIC
  589.  
  590.     PALETTE 1, Color.Set.Shade&(red!, green!, blue!)
  591.  
  592.     LINE (7, 26)-(313, 70), 1, BF                   ' Filled box
  593.  
  594.     '   --- Display current RGB values
  595.     COLOR 4
  596.     LOCATE Color.Values.Row, 3: PRINT USING "Red: #.##"; red!
  597.     COLOR 2
  598.     LOCATE Color.Values.Row, 15: PRINT USING "Green: #.##"; green!
  599.     COLOR 3
  600.     LOCATE Color.Values.Row, 29: PRINT USING "Blue: #.##"; blue!
  601.     COLOR 8
  602. END SUB
  603.  
  604. '   --- Create a LONG INT color value for pallette set from rgb components
  605. FUNCTION Color.Set.Shade& (red!, green!, blue!) STATIC
  606.     r& = red! * 63!
  607.     g& = green! * 63!
  608.     B& = blue! * 63!
  609.     Color.Set.Shade& = r& + g& * 256& + B& * 65536
  610. END FUNCTION
  611.  
  612. ' Increase or decrease hue value by specified amount.
  613. SUB Color.Set.Values (Amount!, hue!) STATIC
  614.  
  615.     Direction% = SGN(Amount!)
  616.     Amount! = ABS(Amount!)
  617.  
  618.     IF Direction% = 1 THEN
  619.         hue! = hue! + Amount: IF hue! > 1! THEN hue! = 1!
  620.     ELSEIF Direction% = -1 THEN
  621.         hue! = hue! - Amount: IF hue! < 0! THEN hue! = 0!
  622.     END IF
  623.     hue$ = LTRIM$(STR$(hue!))
  624.  
  625. END SUB
  626.  
  627. '   --- Prompt user for a descriptive color name and
  628. '       write out the color data, DKB style, to a filename, outfile$
  629. '       Requires CONSTANT named Filename.Row
  630. '       Requires COMMON SHARED named output.file.handle AND output.file$
  631. '
  632. SUB Color.Write.Data (ColorName$, red!, green!, blue!, recno, Reccount, Buffer$()) STATIC
  633.  
  634.     IF ColorName$ <> "" THEN
  635.         OPEN Output.File$ FOR APPEND AS #Output.File.Handle
  636.             PRINT #Output.File.Handle, "DECLARE "; ColorName$; " = COLOUR";
  637.             PRINT #Output.File.Handle, USING " RED #.##"; red!;
  638.             PRINT #Output.File.Handle, USING " GREEN #.##"; green!;
  639.             PRINT #Output.File.Handle, USING " BLUE #.##"; blue!
  640.         CLOSE #Output.File.Handle
  641.         Reccount = Reccount + 1
  642.         recno = Reccount
  643.         Buffer$(Reccount, 1) = ColorName$
  644.         Buffer$(Reccount, 2) = LTRIM$(STR$(red!))
  645.         Buffer$(Reccount, 3) = LTRIM$(STR$(green!))
  646.         Buffer$(Reccount, 4) = LTRIM$(STR$(blue!))
  647.         CALL Chime.Friendly
  648.     END IF
  649.  
  650. END SUB
  651.  
  652. '   --- Check status of caps-lock
  653. '       Requires PUBLIC CONSTANT named Prompt.Row (generally 24)
  654. SUB Gui.CapsState STATIC
  655. STATIC OldState, NewState, CapsOn
  656.  
  657.     DEF SEG = 0                                 'Set data segment to low memory
  658.     OldState = CapsOn
  659.     CapsOn = (PEEK(&H417) AND 64)
  660.     NewState = CapsOn
  661.     IF OldState <> NewState OR NOT Called.Before THEN
  662.         IF CapsOn THEN
  663.             CALL Gui.Panel(6, 182, 40, 192, 1)
  664.           LOCATE 24, 2: PRINT "CAPS";
  665.         ELSE
  666.             CALL Gui.Panel(6, 182, 40, 192, -1)
  667.             LOCATE 24, 2: PRINT "caps";
  668.         END IF
  669.     END IF
  670.     DEF SEG                                      'Restore default data segment
  671.  
  672.     ' The following is, I believe, a BASIC only trick, since BASIC does not
  673.     ' REQUIRE variable initializing. Of course, Called.Before *could* be
  674.     ' defined as a COMMON SHARED variable and initialized to FALSE
  675.     ' outside of this function, but why bother?
  676.  
  677.     Called.Before = TRUE
  678.  
  679. END SUB
  680.  
  681. '   --- Center a string on the current line
  682. SUB Gui.Center.Msg (AtRow, a$) STATIC
  683.     IF a$ = "" THEN CALL Gui.Clear.Msg(AtRow): EXIT SUB
  684.     LeftTab% = 21 - LEN(a$) / 2
  685.     WLeft% = (LeftTab% * 8) - 12
  686.     WRight% = WLeft% + (LEN(a$) * 8) + 10
  687.     WTop% = AtRow * 8 - 12
  688.     WBottom% = WTop% + 14
  689.     CALL Gui.Panel(WLeft%, WTop%, WRight%, WBottom%, -1)
  690.     LOCATE AtRow, LeftTab%: PRINT a$;
  691. END SUB
  692.  
  693. '   --- Clear a line
  694. SUB Gui.Clear.Msg (AtRow) STATIC
  695.     a$ = SPACE$(34)
  696.     LeftTab% = 21 - (LEN(a$) / 2)
  697.     WLeft% = LeftTab% * 8 - 12
  698.     WRight% = LEN(a$) * 8 + WLeft% + 4
  699.     WTop% = AtRow * 8 - 12
  700.     WBottom% = WTop% + 14
  701.     CALL Gui.Panel(WLeft%, WTop%, WRight%, WBottom%, 0)
  702.     LOCATE AtRow, LeftTab%: PRINT a$;
  703. END SUB
  704.  
  705. '--- Read keybuffer and check caps lock state while waiting.  Requires
  706. '--- the subprogram Gui.CapsState().
  707. SUB Gui.KbGet (a$) STATIC
  708.     a$ = ""
  709.     WHILE a$ = ""
  710.         a$ = INKEY$
  711.         CALL Gui.CapsState
  712.     WEND
  713. END SUB
  714.  
  715. SUB Gui.Panel (WinLeft%, WinTop%, WinRight%, WinBottom%, Depth%) STATIC
  716. STATIC i%
  717.  
  718. ' Parameter Depth := -1 FOR INSET, 1 FOR OUTSET
  719. '                     -2 FOR INSET 2 DEEP, 3 TO OUTSET 3 DEEP, ETC.
  720. INSET% = (Depth% < 0)
  721. Depth% = ABS(Depth%)
  722.  
  723. IF Depth% = 0 THEN
  724.     LINE (WinLeft% + 1, WinTop% - 1)-(WinRight% - 1, WinBottom% + 1), 7, BF
  725. ELSE
  726.     FOR i% = 0 TO Depth% - 1
  727.         IF INSET% THEN                                 ' INSET PANEL
  728.             LINE (WinLeft% + i%, WinTop% + i%)-(WinLeft% + i%, WinBottom% - i%), 8' LEFT SIDE
  729.             LINE (WinLeft% + i%, WinTop% + i%)-(WinRight% - i%, WinTop% + i%), 8  ' TOP LINE
  730.             LINE (WinLeft% + i%, WinBottom% - i%)-(WinRight% - i%, WinBottom% - i%), 15' BOTTOM LINE
  731.             LINE (WinRight% - i%, WinTop% + i%)-(WinRight% - i%, WinBottom% - i%), 15' RIGHT SIDE
  732.         ELSE                                             ' OUTSET PANEL
  733.             LINE (WinLeft% + i%, WinTop% + i%)-(WinLeft% + i%, WinBottom% - i%), 15' LEFT SIDE
  734.             LINE (WinLeft% + i%, WinTop% + i%)-(WinRight% - i%, WinTop% + i%), 15 ' TOP LINE
  735.             LINE (WinLeft% + i%, WinBottom% - i%)-(WinRight% - i%, WinBottom% - i%), 8' BOTTOM LINE
  736.             LINE (WinRight% - i%, WinTop% + i%)-(WinRight% - i%, WinBottom% - i%), 8' RIGHT SIDE
  737.         END IF
  738.     NEXT i%
  739. END IF
  740. END SUB
  741.  
  742. SUB Gui.Screen.Init
  743.     CLS
  744.  
  745.     ' --- Init screen to graphics mode 13 (MCGA 320x200x256)
  746.     '        Colorswitch on, Active Page 0, Visual Page 0
  747.     SCREEN 13, 1, 0, 0
  748.  
  749.     PALETTE 0, Color.Set.Shade&(.66, .66, .66) ' Set background to color 7
  750.  
  751.     ' Gui.Panel Parameters: Left top right bottom Depth
  752.     CALL Gui.Panel(1, 1, 319, 198, 1)     ' Border panel
  753.     CALL Gui.Panel(6, 5, 314, 18, -2)     ' Color values window (Top line)
  754.     CALL Gui.Panel(6, 25, 314, 71, -1)    ' Color display window
  755.     CALL Gui.Panel(6, 78, 314, 176, 1)    ' Main panel (Help screen,view,etc)
  756.     ' Useable text area inside lower panel : rows 14-22, cols 2-38
  757.  
  758.     CALL Gui.Panel(60, 182, 138, 192, 1)     ' File button
  759.     COLOR 8
  760.     LOCATE 24, 9: PRINT "[F]=Files";
  761.     COLOR 7
  762.     CALL Gui.Panel(278, 182, 314, 192, -1)   ' Increment window, line 24
  763.  
  764.     CALL Color.Preview.Sphere(160, 128, 25, .5, .5, .5)
  765.  
  766. END SUB
  767.  
  768. '   --- Wait forever for a keypress
  769. SUB Gui.Waitkey STATIC
  770.      CALL Gui.Panel(148, 182, 256, 192, 1)    ' Press any key panel
  771.      COLOR 15
  772.      LOCATE 24, 20: PRINT "Press any key";
  773.      COLOR 8
  774.      a$ = ""
  775.      WHILE a$ = ""
  776.          CALL Gui.KbGet(a$)                        ' Check for keypress
  777.      WEND
  778.      CALL Gui.Panel(147, 182, 261, 192, 0)     ' Erase panel
  779. END SUB
  780.  
  781.